C
C	.TITLE	MC68000 CROSS ASSEMBLER SUPPORT
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C ASSEMBLY LANGUAGE SUBROUTINES FOR MC68000 CROSS-ASSEMBLER.
C FORTRAN LINKAGE TO THESE ROUTINES IS AS FOLLOWS:
C	1. RETURN VIA 'RTS PC'.
C	2. R5 POINTS TO PARAMETER LIST WITH FOLLOWING:
C		A. NUMBER OF PARAMETERS.
C		B. ADDRESS OF FIRST PARAMETER
C		C. ADDRESS OF SECOND PARAMETER, ETC.
C	3. FUNCTION SUBROUTINES (INTEGER) RETURN VALUE IN R0.
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C ** I4CLR **
C
C CLEAR LOW AND HIGH WORDS OF DOUBLE PRECISION VARIABLE
C ADR OF LOW WORD PASSED VIA (R5)
C
	subroutine i4clr(value)
	implicit integer(a-z)
	value=0
	return
	end
C
C ** GETBIT **
C
C SUBROUTINE TO CONVERT 4 LSB OF A INTEGER*2 VARIABLE TO A HEX
C ASCII DIGIT.  THE INTEGER IS IN THE FIRST PARAMETER AND THE
C HEX DIGIT IS RETURNED IN THE SECOND PARAMETER (BYTE).  THE
C INTEGER IS SHIFTED RIGHT BY 4 BEFORE RETURNING.
C
	subroutine getbit( i2val , bytval )
	implicit integer(a-z)
	integer*2 i2val,tval,hmask,lmask
	byte bytval,tbyt(2)
	equivalence ( tval , tbyt(1) )
	data hmask,lmask/'F000'x,'000F'x/
	tval=i2val
	tval=iiand(tval,lmask)
	bytval=tbyt(1)+48
	if(bytval.gt.57)bytval=bytval+7
	tval=i2val
	i2val=iishft(i2val,-4)
	if(tval.lt.0)i2val=iior(i2val,hmask)
	return
	end
C
C ** ICKVAL **
C
C INTEGER FUNCTION TO CHK IF I*2 VARIABLE IS IN THE RANGE
C -64,63. IF IT IS A VALUE OF 0 IS RETURNED, OTHERWISE
C A VALUE OF ONE IS RETURNED
C
	integer function ickval( i2val )
	implicit integer (a-z)
	integer*2 i2val
	ickval=0
	if((i2val.lt.-64).or.(i2val.gt.63))ickval=1
	return
	end
C
C	THE FOLLOWING INTEGER*4 ARITHMETIC ROUTINES ARE USED INSTEAD
C	OF F4P CALLS TO PERMIT THE CROSS ASSEMBLER TO RUN WITHOUT
C	MODIFICATIONS ON EITHER RT-11 OR RSX-11 SYSTEMS
C
	integer function jadd( op1 , op2 , result )
	implicit integer (a-z)
	result=op1+op2
	jadd=0
	return
	end
C
C	INTEGER*4 SUBTRACTION
C
	integer function jsub( op1 , op2 , result )
	implicit integer (a-z)
	result=op1-op2
	jsub=0
	return
	end
C
C	INTEGER*4 MULTIPLICATION
C
	integer function jmul( op1 , op2 , result )
	implicit integer (a-z)
	result=op1*op2
	jmul=0
	return
	end
C
C	INTEGER*4 DIVISION
C
	integer function jdiv ( op1 , op2 , result )
	implicit integer (a-z)
	result=op1/op2
	jdiv=0
	return
	end
C
C	INTEGER*4 LOGICAL AND
C
	integer function jand ( op1 , op2 , result )
	implicit integer (a-z)
	result=jiand(op1,op2)
	jand=0
	return
	end
C
C	INTEGER*4 INCLUSIVE OR
C
	integer function jor ( op1 , op2 , result )
	implicit integer (a-z)
	result=jior(op1,op2)
	jor=0
	return
	end
C
C ** JLSHF **
C
C	INTEGER*4 LEFT SHIFT (UNSIGNED)
C
	integer function jlshf ( op1 , op2 , result )
	implicit integer (a-z)
	result=jishft(op1,op2)
	jlshf=0
	return
	end
C
C ** JRSHF **
C
C	INTEGER*4 RIGHT SHIFT (UNSIGNED)
C
	integer function jrshf ( op1 , op2 , result )
	implicit integer (a-z)
	result=jishft(op1,-op2)
	jrshf=0
	return
	end
C
C ** JICMP **
C
C	COMPARE A 32 BIT SIGNED NUMBER WITH A 16 BIT SIGNED NUMBER
C	FUNCTION RETURNS A VALUE OF ZERO IF THE NUMBERS ARE EQUIVALENT
C
	integer function jicmp ( i4val , i2val )
	implicit integer (a-z)
	integer*2 i2val
	jicmp=1
	if(i4val.eq.i2val)jicmp=0
	return
	end
C
C ** JMOV **
C
C	INTEGER*4 MOVE
C
	subroutine jmov ( val1 , val2 )
	implicit integer (a-z)
	val2=val1
	return
	end
C
C ** BLDMAP (DLIST,ALIST,OUTPUT) **
C
C	CREATE A REGISTER BITMAP FROM A DATA AND ADR REG MAP
C
	subroutine bldmap ( val1 , val2 , result )
	implicit integer (a-z)
	integer*2 val1,val2,tmp1,tmp2,result
	byte btmp1(2),btmp2(2)
	equivalence ( tmp1,btmp1(1) ) , ( tmp2,btmp2(1) )
	tmp1=val1
	tmp2=val2
	btmp1(2)=btmp2(1)
	result=tmp1
	return
	end
C
C ** JICVT (I*2,I*4 RESULT) **
C
C	I*2 TO I*4 CONVERSION (SIGNED)
C
	integer function jicvt ( i2val , i4val )
	implicit integer (a-z)
	integer*2 i2val
	i4val=i2val
	jicvt=0
	return
	end
c
c
c
c
